      SUBROUTINE ERRINT(IFIL,FNAM)
C=========================================================================
C
C SUBROUTINE : ERRINT
C------------
C PURPOSE    : Read error messages and error names from file
C              (see subroutine ERRCHK for processing)
C PARAMETERS :
C     IFIL   : unit number
C     FNAM   : file name
C
C=========================================================================
C
      CHARACTER*(*) FNAM
      INCLUDE 'COM_ERR.INC'
      CHARACTER LINE*80,KEY*10,SUBR*15,CRDSTR*15,MESS*60,FNAM2*80
      LOGICAL LOP
C 
      FNAM2=FNAM
      NERRMS=1
      ERRSUB(1)='unknown'
      ERRCOD(1)=7
      ERRMES(1)='Error message not defined'
      INQUIRE (FILE=FNAM,OPENED=LOP)
      IF (.NOT.LOP) OPEN (IFIL,FILE=FNAM,STATUS='OLD',READONLY)
  100 READ (IFIL,'(A)',END=999) LINE
      KEY=CRDSTR(LINE,K)
      SUBR=CRDSTR(LINE,K)
      CALL IRDSTR(ICOD,LINE,K,*900)
      MESS=LINE(IFSTCH(LINE):)
      IF (KEY.EQ.' '.OR.SUBR.EQ.' '.OR.MESS.EQ.' ') CALL ABORT
     +('F',6,'String(s) blank','ERRINT',0,999)
      IF (ICOD.LT.1.OR.ICOD.GT.10) CALL ABORT
     +('F',6,'ICODE out of range','ERRINT',0,999)
      NERRMS=NERRMS+1
      IF (NERRMS.GT.MAXERR) CALL ABORT
     +('F',3,'Reading error messages in ERRINT','MAXERR',NERRMS,999)
      ERRKEY(NERRMS)=KEY
      ERRSUB(NERRMS)=SUBR
      ERRCOD(NERRMS)=ICOD
      ERRMES(NERRMS)=MESS
      GOTO 100
C
  900 CALL ABORT('F',6,'Integer expected','ERRINT',0,999)
  999 IF (NERRMS.LE.0) CALL ABORT('F',1,
     +'Error messages from'//FNAM2(1:LENSTR(FNAM2)),'ERRINT',IFIL,999)
C
      CLOSE (IFIL)
      RETURN
      END
      SUBROUTINE ERRCHK(LEVEL,KEY)
C=========================================================================
C
C SUBROUTINE : ERRCHK
C------------
C PURPOSE    : Initiate error processing based on information in
C              error message file (see subroutine ERRINT) and on
C              data stored in /ABRTS1/ and /ABRTS2/ by calls to
C              STERRS, STERRP or STERRV.
C PARAMETERS :
C     LEVEL  : flag indicating error level
C     KEY    : keyword indicating error
C
C=========================================================================
C
      CHARACTER*(*) LEVEL,KEY
      INCLUDE 'COM_ERR.INC'
      INCLUDE 'COM_ABORT.INC'
      INCLUDE 'STANDDEF.INC'
      CHARACTER*80 GTIOSV,STRING
C
    5 FORMAT(/' >>> Error: ',A,' in subroutine ',A)
    6 FORMAT(/' >>> Warning: ',A,' in subroutine ',A)
   10 FORMAT(' >>> Last line read: ',A)
   20 FORMAT(' >>> ',A)
C
      DO 100 IERR=2,NERRMS
      IF (ERRKEY(IERR).EQ.KEY) GOTO 200
  100 CONTINUE
      IERR=1
      ERRKEY(1)=KEY
  200 CONTINUE
      IF (LEVEL.NE.ABW) THEN
         WRITE (ITXERR,5) ERRKEY(IERR),ERRSUB(IERR)
      ELSE
         WRITE (ITXERR,6) ERRKEY(IERR),ERRSUB(IERR)
      ENDIF
      STRING=GTIOSV()
      IF (STRING.NE.' ') WRITE (ITXERR,10) STRING(1:LENSTR(STRING))
      IF (ERRSTR.NE.' ') WRITE (ITXERR,20) ERRSTR
      IF (IPAR.EQ.' ') IPAR=ERRSUB(IERR)
      ERRLEV=LEVEL
      IF (ERRLEV.EQ.ABH) THEN
         ERRLEV='W'
         ABHOLD=.TRUE.
      ELSE
         ABHOLD=.FALSE.
      ENDIF
      CALL ABORT(ERRLEV,ERRCOD(IERR),ERRMES(IERR),IPAR,IVAL,IFLAG)
      IPAR=' '
      IVAL=0
      ERRSTR=' '
      ERRLEV=' '
      IFLAG=0
      RETURN
      END
      FUNCTION IGTERR
C=========================================================================
C
C FUNCTION   : IGTERR
C------------
C PURPOSE    : Returns 1 if ABHOLD has been set in ERRCHK (by call with
C              LEVEL=ABH), i.e. if fatal error has been encountered
C              but put on hold, otherwise 0
C
C=========================================================================
C
      INCLUDE 'COM_ABORT.INC'
C
      IF (ABHOLD) THEN
         IGTERR=1
      ELSE
         IGTERR=0
      ENDIF
      RETURN
      END
      SUBROUTINE STERRS(STRING)
C=========================================================================
C
C     Sets ERRSTR for call to ABORT by ERRCHK
C
C=========================================================================
C
      CHARACTER*(*) STRING
      INCLUDE 'COM_ABORT.INC'
C
      IF (ERRSTR.EQ.' ') ERRSTR=STRING
      RETURN
      END
      SUBROUTINE STERRV(NUM)
C=========================================================================
C
C     Sets IVAL for call to ABORT by ERRCHK
C
C=========================================================================
C
      INCLUDE 'COM_ABORT.INC'
C
      IF (IVAL.EQ.0) IVAL=NUM
      RETURN
      END
      SUBROUTINE STERRP(STRING)
C=========================================================================
C
C     Sets IPAR for call to ABORT by ERRCHK
C
C=========================================================================
C
      CHARACTER*(*) STRING
      INCLUDE 'COM_ABORT.INC'
C
      IF (IPAR.EQ.' ') IPAR=STRING
      RETURN
      END
      SUBROUTINE ABORT(ERRLEV,ICODE,STRING,IPAR,IVAL,IFLAG)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     This routine issues error-messages and aborts the calling
C     program or returns to it. ERRLEV determines the type of action:
C     'F'---fatal error by call to subr.SYSTEM
C     'W'---warning by call to subr.SYSTEM and return
C     'S'---warning by call to subr.SYSTEM and stop
C
C     IFLAG is a flag which is passed to subr.SETR1G (intended for
C     communication with the operating system).
C
C     Error-messages are printed and one message is passed to 
C     subr. MESSGE (can be put in separate dayfile, logfile etc.).
C
C     The following options are available (ICODE):
C     1---end of file encountered
C         STRING---definition of the record expected
C         IPAR  ---name of subroutine
C         IVAL  ---unit number
C     2---inconsistent input data
C         STRING---indication of the error
C         IPAR  ---relevant string value (e.g. name of subroutine)
C         IVAL  ---relevant numerical value
C     3---dimension bound exceeded because program parameters are
C         too small to run with the input-data
C         STRING---indication of location where error was detected
C         IPAR  ---name of the parameter to be changed
C         IVAL  ---indication of the least value to assign to parameter
C     4---dimension bound exceeded because of internal program errors
C         STRING---indication of location where error was detected
C         IPAR  ---relevant string value
C         IVAL  ---relevant numerical value
C     5---non matching parameters
C         STRING---place error occurred
C         IPAR  ---parameter in error
C         IVAL  ---previous value for parameter
C     6---any program error
C         STRING---indication of error
C         IPAR  ---relevant string value (e.g. name of subroutine)
C         IVAL  ---relevant numerical value
C     7---error in algorithm
C         STRING---indication of error
C         IPAR  ---relevant string value (e.g. name of subroutine)
C         IVAL  ---relevant numerical value
C     8---warning message
C         STRING---indication of the error
C         IPAR  ---relevant string value
C         IVAL  ---relevant numerical value
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDFIL.INC'
C
      CHARACTER STRING*(*),AST*5,IPAR*(*),DAY*4,ERRLEV
      CHARACTER STR*60,JPAR*7
      CHARACTER TXT1*35,TXT2*25,TXT3*26,TXT4*41,TXT5*25,TXT6*25,TXT7*20,
     +          TXT8*9
      DATA AST,DAY/' >>> ','DAYF'/
      DATA TXT1/'END OF FILE ENCOUNTERED, EXPECTED: '/
      DATA TXT2/'INCONSISTENT INPUT DATA: '/
      DATA TXT3/'DIMENSION BOUND EXCEEDED: '/
      DATA TXT4/'DIMENSION BOUND EXCEEDED -- PROGRAM ERROR'/
      DATA TXT5/'NON MATCHING PARAMETERS: '/
      DATA TXT6/'PROGRAM EXECUTION ERROR: '/
      DATA TXT7/'ERROR IN ALGORITHM: '/
      DATA TXT8/'WARNING: '/
C
      CALL SETR1G(IFLAG)
      STR=STRING
      LT=LENSTR(STR)
      LS=LENSTR(STRING)
      JPAR=IPAR
      NERR=51
      IF (ERRLEV.EQ.'F') NERR=52
C     WRITE (ITXERR,1000)
      GOTO (10,20,30,40,50,60,70,80) ICODE
   10 WRITE (ITXERR,200) AST,TXT1,STRING(1:LS)
      WRITE (ITXERR,400) AST,IPAR
      WRITE (ITXERR,500) AST,IVAL
      CALL MESSGE(TXT1//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'PREMATURE END OF FILE')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- CHECK INPUT FOR MISSING DATA --'
   20 WRITE (ITXERR,200) AST,TXT2,STRING(1:LS)
      WRITE (ITXERR,600) AST,IPAR,AST,IVAL
      CALL MESSGE(TXT2//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'INCONSISTENT DATA. PROBABLY USER ERROR')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- INCONSISTENT DATA -- PROGRAM ABORTED --'
   30 WRITE (ITXERR,200) AST,TXT3
      WRITE (ITXERR,200) AST,'Error occurred at ',STRING(1:LS)
      WRITE (ITXERR,300) AST,'Parameter ',JPAR,' should be at least',
     +   IVAL
      CALL MESSGE(TXT3//JPAR//' at '//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'PARAMETER TOO SMALL')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- ENLARGE PARAMETER --'
   40 WRITE (ITXERR,200) AST,TXT4
      WRITE (ITXERR,200) AST,'Error occurred at ',STRING(1:LS)
      WRITE (ITXERR,600) AST,IPAR,AST,IVAL
      CALL MESSGE(TXT4//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'DIMENSION BOUND INCORRECT')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- CORRECT PROGRAM --'
   50 WRITE (ITXERR,200) AST,TXT5,STRING(1:LS)
      WRITE (ITXERR,300) AST,'Parameter ',JPAR,' should be at least',
     +   IVAL
      CALL MESSGE(TXT5//JPAR//' at '//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'CONFLICTING PARAMETERS')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- NON MATCHING PARAMETERS --'
   60 WRITE (ITXERR,200) AST,TXT6,STRING(1:LS)
      WRITE (ITXERR,600) AST,IPAR,AST,IVAL
      CALL MESSGE(TXT6//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'FATAL RUN-TIME CONDITION')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- PROGRAM EXECUTION ERROR --'
   70 WRITE (ITXERR,200) AST,TXT7,STRING(1:LS)
      WRITE (ITXERR,600) AST,IPAR,AST,IVAL
      CALL MESSGE(TXT7//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'ERROR IN ALGORITHM')
      IF (ERRLEV.EQ.'W') RETURN
      STOP 'ALGORITHMIC ERROR -- CORRECT PROGRAM'
   80 WRITE (ITXERR,200) AST,TXT8,STRING(1:LS)
      WRITE (ITXERR,600) AST,IPAR,AST,IVAL
      CALL MESSGE(TXT8//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'WARNING MESSAGE')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- WARNING -- PROGRAM ABORTED --'
  200 FORMAT(3A)
  300 FORMAT(4A,I8)
  400 FORMAT(A,'Subroutine: ',A)
  500 FORMAT(A,'Unit number: ',I3)
  600 FORMAT(A,'String passed: ',A/A,'Value  passed: ',I8)
 1000 FORMAT(/)
      END
      SUBROUTINE CNSTAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     SUBROUTINE CNSTAN                                                C
C                                                                      C
C     Note: Common block is partially filled by BLOCK DATA CONBLD,     C
C           see file CONBLD.INC. This file must be 'INCLUDEd' in any   C
C           program that uses CNSTAN.                                  C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_CONST.INC'
      INCLUDE 'STANDFIL.INC'
C
      HARTRE = (ELCHA * CLIGHT)**2   *   1.E-7   /   (BOHR*1.E-10)
      DEBYE = 1.E-11   /   (CLIGHT * BOHR * ELCHA)
      DBETA = 1.E0  /  ( BOLTZK * AVOG * 1.E-3 )
      HARTRE = HARTRE * AVOG * 1.E-3
C
    5 FORMAT(/)
   10 FORMAT(1X,A7,1PE12.3,1X,A)
C
      WRITE (ITXOUT,5)
      WRITE (ITXOUT,10) 'PI',PI
      WRITE (ITXOUT,10) 'BOHR',BOHR,' Angstrom'
      WRITE (ITXOUT,10) 'HARTRE',HARTRE,' kJ/mol'
      WRITE (ITXOUT,10) 'DEBYE',DEBYE,' a.u.'
      WRITE (ITXOUT,10) 'DBETA',DBETA,' Kelvin/(kJ/mol)'
      WRITE (ITXOUT,10) 'CALORY',CALORY
      WRITE (ITXOUT,10) 'AVOG',AVOG
      WRITE (ITXOUT,10) 'CLIGHT',CLIGHT
      WRITE (ITXOUT,10) 'ELCHA',ELCHA
      WRITE (ITXOUT,10) 'BOLTZK',BOLTZK
      WRITE (ITXOUT,5)
C
      RETURN
      END
      SUBROUTINE HEADRT(PNAME,VERSN)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine HEADRT prints standard header
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDFIL.INC'
      INCLUDE 'COM_JOBD.INC'
      CHARACTER*(*) PNAME,VERSN
      CHARACTER*80  STAR
C
      DO 10 I=1,80
      STAR(I:I) = '*'
  10  CONTINUE
C
      PNM  = PNAME
      VNM  = VERSN
      IPNM = LENSTR(PNAME)
      IVERS= LENSTR(VERSN)
C
      WRITE (ITXOUT,*) ' '
      WRITE (ITXOUT,*) ' *** Program ',PNAME(1:IPNM)
     +                ,' *** Version ',VERSN(1:IVERS),' ***'
      WRITE (ITXOUT,*) ' '
      WRITE (ITXOUT,*) '     written by Ton Rullmann'
      WRITE (ITXOUT,*) '     Bijvoet Center for Biomolecular Research'
      WRITE (ITXOUT,*) '     Utrecht University, The Netherlands'
      WRITE (ITXOUT,*) ' '
      WRITE (ITXOUT,*) '     (c) 1993'
      WRITE (ITXOUT,*) ' '
      WRITE (ITXOUT,*) ' ',STAR(1:IPNM+IVERS+29)
      WRITE (ITXOUT,*) ' '
      RETURN
      END
      SUBROUTINE WRPROG(IFIL)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine WRPROG writes program identification to IFIL
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDDEF.INC'
      INCLUDE 'COM_JOBD.INC'
C
      WRITE (IFIL,'(A,''date:'',A,1X,A,'' vers. '',A,'' of '',A)')
     +   COMMNT,DATE,PNM(1:LENSTR(PNM)),VNM(1:LENSTR(VNM)),CMPDAT
      RETURN
      END
      SUBROUTINE FOOTER
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine FOOTER prints standard footer belonging to header
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDFIL.INC'
      INCLUDE 'COM_JOBD.INC'
C
      WRITE (ITXOUT,1000) PNM(1:LENSTR(PNM))
 1000 FORMAT (//'  *** End of program ',A,' ***'/)
C
      RETURN
      END
      SUBROUTINE BUSY (TEXT)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine BUSY prints message about what the program is doing
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDFIL.INC'
      INCLUDE 'COM_JOBD.INC'
      CHARACTER*(*) TEXT
C
      WRITE (ITXOUT,1000) PNM(1:LENSTR(PNM)),TEXT(1:LENSTR(TEXT))
 1000 FORMAT ('0 <',A,'> ... ',A)
C
      RETURN
      END
      SUBROUTINE STARTR(ORG,ALT)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     SUBROUTINE STARTR
C     - Initializes data for IO routines (subr. NOIOIN, library useful.f),
C       and for error processing by ERRCHK (see this library).
C     - Calculates physical constants (subr. CNSTAN; include 'conbld.inc'
C       in main program!).
C     - Retrieves current date and time (subr. GETDAT, GETTIM)
C     - Retrieves compilation date and time (subr. CMPILX)
C     - Retrieves operating system parameters (subr. JOBJE)
C     ORG = 'B' : BATCH processing mode (IAF set to .false.)
C         = 'I' : INTERACTIVE processing mode (IAF set to .true.)
C         = '?' : read mode from input
C     ALT = 'Y' : use alternate output file (ALTOUT set to .true.)
C         = 'N' : do not use alternate output file (ALTOUT set to .false.)
C         = '?' : read mode from input
C     Note: when after the call to JOBJE IAF is .false. (i.e. the process is
C           qualified as BATCH by the operating system) the values of
C           ORG and ALT are ignored, i.e. IAF and ALTOUT are both .false..
C           This depends of course on JOBJE (the default return value for IAF 
C           - if no access to the o.s. is made - should be .true.)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_JOBD.INC'
      INCLUDE 'COM_ABORT.INC'
      CHARACTER*(*) ORG,ALT
      CHARACTER*10 GETDAT,GETTIM,CH*1,UPPRCS*1
C
    1 FORMAT(A)
   10 FORMAT(' Program compiled on ',A10,' at ',A10/,
     +       ' today is',12X,A10,4X,A10)
   20 FORMAT(' Processing mode batch or interactive? Type B or I')
   30 FORMAT(' Use alternate output file? Type Y or N')
C
C----- get and print compilation and current dates and times
      DATE=GETDAT()
      TIME=GETTIM()
      CALL CMPILX
      WRITE (*,10) CMPDAT,CMPTIM,DATE,TIME
C----- get operating system parameters
      CALL JOBJE
C----- default no alternate output file
      ALTOUT=.false.
C----- use default setting in BATCH mode
      IF (.NOT.IAF) GOTO 100
C----- set processing mode (BATCH or INTERACTIVE)
      CH=ORG(1:1)
      IF (CH.EQ.'?') THEN
         WRITE (*,20)
         READ (*,1) CH
      ENDIF
      IAF=UPPRCS(CH).NE.'B'
C----- set alternate output mode
      CH=ALT(1:1)
      IF (CH.EQ.'?') THEN
         WRITE (*,30)
         READ (*,1) CH
      ENDIF
      ALTOUT=UPPRCS(CH).NE.'N'
C
  100 CONTINUE
C
C----- initialize data for IO routines and for error processing
      CALL NOIOIN
      ERRSTR=' '
      IPAR=' '
      ERRLEV=' '
      IFLAG=0
      IVAL=0
C
C----- calculate physical constants
      CALL CNSTAN
C
      RETURN
      END
      SUBROUTINE PRTIME(NT,IOP,TIM,STRING)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine PRTIME prints STRING and the accumulated CPU time
C     (delivered by GETCPT) minus TIM. After exit from the routine
C     TIM has been replaced by the accumulated CPU time (and can be
C     passed in the next call as the new offset).
C     If IOP.eq.1 the string is also passed to MESSGE.
C     NT is the unit number for print output.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) STRING
C
   10 FORMAT(//1X,A,F8.3,' CPU SECONDS'/)
      T=TIM
      CALL GETCPT(TIM)
      WRITE (NT,10) STRING(1:LENSTR(STRING)),TIM-T
      IF (IOP.EQ.1) CALL MESSGE(STRING,'DISP')
      RETURN
      END
      SUBROUTINE WREVAR(IFIL,ENVVAR)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Subroutine WREVAR gets the value of the environment variable 
C     ENVVAR, and prints it to IFIL.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'STANDDEF.INC'
      CHARACTER*(*) ENVVAR
      CHARACTER*80 WORD
C
      CALL GETENV(ENVVAR,WORD)
      WRITE (IFIL,'(A,1X,A,'': '',A)') 
     +   COMMNT,ENVVAR(1:LENSTR(ENVVAR)),WORD(1:LENSTR(WORD))
      RETURN
      END
      SUBROUTINE IOPEN(IUNIT,ENVVAR,FILNAM,STAT)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     IOPEN gets the value of the environment variable ENVVAR,
C     puts it in FILNAM, and opens unit IUNIT with name FILNAM
C     and status STAT (if status is 'OLD', then open with 'READONLY').
C     When the environment variable is returned with 'NO_GETENV' (see
C     subroutine GETENV) FILNAM is set equal to ENVVAR (i.e. the name of 
C     the variable becomes its content).
C     When the environment variable is returned with ' ' a fatal error
C     call is made. (This might be changed by opening the file by number).
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INCLUDE 'STANDDEF.INC'
      CHARACTER*(*) ENVVAR,FILNAM,STAT
      CHARACTER*80 LOCVAR
C
      LOCVAR=ENVVAR
C---Get the contents of ENVVAR
      CALL GETENV(ENVVAR,FILNAM)
C---Simple way out on non-Unix systems
      IF (FILNAM.EQ.'NO_GETENV') FILNAM=ENVVAR
C---Check whether we have a file name
      IF (FILNAM.EQ.' ') CALL ABORT(ABF,6,
     +  'Empty env.var. '//LOCVAR(1:LENSTR(LOCVAR)),'IOPEN',0,999)
C---Open the file
      IF (STAT.EQ.'OLD') THEN
         OPEN(IUNIT,FILE=FILNAM,STATUS=STAT,READONLY)
      ELSE
         OPEN(IUNIT,FILE=FILNAM,STATUS=STAT)
      ENDIF
      RETURN
      END
